home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / DB_CLIPP / 0643C.ZIP / CLEAN.PAS < prev    next >
Pascal/Delphi Source File  |  1987-05-31  |  9KB  |  287 lines
  1. PROGRAM CLEAN;
  2.  
  3. {Clean.com:  removes blank lines, comment lines and leading blanks from
  4. dBASE III command files to help improve execution speed.
  5.  
  6. Author: Craig S. Steinberg, O.D.
  7. Compuserve ID:  70166,337 (Ashton Tate Sig or IBM Software Sig)
  8. dBASE RBBS, Glendale California
  9. Version 1.0: May 30, 1986
  10. Version 2.1  June 3, 1986
  11.  
  12. Type CLEAN ? for help
  13.  
  14. version 1.1:  windows added, 5/31/86
  15. version 2.0:  prompt for file names and allow switches to control which
  16. of the three functions will operate,  6/1/86.
  17. version 2.1:  gets current video mode itself,  6/3/86.
  18.  
  19. Hopeful updates (in future):
  20.    1.  Switch to remove indented comment lines also;
  21.    2.  Switch to allow shortening of dBASE Command words to 4 characters;}
  22.  
  23.  
  24. {$C-}
  25.  
  26. {variable declarations}
  27. var
  28.    Infile,Outfile : text;
  29.    line           : string[255];
  30.    c,f            : string[1];
  31.    NextLine       : boolean;
  32.    l              : integer;
  33.    InFileName     : string[12];
  34.    OutFileName    : string[12];
  35.    OutFileNameT   : string[12];  {temp outfilename}
  36.    ps             : string[12];
  37.    IOerr          : boolean;
  38.    Value          : byte;
  39.    PTOOLWIN_Screen_Type : char;
  40.  
  41. const
  42.    PTOOLWIN_Number_of_Windows = 2;
  43.    Comment  : boolean = True;
  44.    Indent   : boolean = True;
  45.    Blank    : boolean = True;
  46.  
  47. {***Get windowing include file***}
  48. { by Ostrander Data Services }
  49. {$I PTOOLWI2.INC}
  50.  
  51. {***Initialize two windows***}
  52. Procedure WindowSetup;
  53. begin
  54.    PTWSet (1, 6, 1, 66, 13, 2, 7, 0);
  55.    PTWSet (2, 15, 7, 74, 18, 1, 7, 0);
  56. end;
  57.  
  58. {wait for any key to be struck to continue}
  59. PROCEDURE Wait;
  60. Var
  61.   AnyKey : Char;
  62. Begin
  63.   Read(Kbd,AnyKey);
  64. End;
  65.  
  66. {help info appears when no parameters are entered with clean}
  67. PROCEDURE Help;
  68. begin
  69.    PTWSet (1, 1, 1, 79, 24,  2, 0, 7);
  70.    PTWOpen (1);
  71.    ClrScr;
  72.    GotoXY (1,1);
  73.    writeln('CLEAN.COM 2.1 by Craig S. Steinberg, June 2, 1986.');
  74.    writeln;
  75.    writeln('Clean removes indentation, blank lines and comments from dBASE programs.');
  76.    writeln;
  77.    writeln('Format:  CLEAN [?] [/bci]');
  78.    writeln;
  79.    writeln('   ?  Displays this help screen.');
  80.    writeln('   /  Allows you to EXCLUDE the removal of specified lines.');
  81.    writeln('        b - do not remove blank lines');
  82.    writeln('        c - do not remove comment lines');
  83.    writeln('        i - do not remove indentation');
  84.    writeln;
  85.    writeln('b, c and i may be combined in any fashion.  There is one caveat to using the');
  86.    writeln('"i" option.  If you select i (do not remove indentation) then indented');
  87.    writeln('comments will not be removed.  To remove indented comments i must be active.');
  88.    writeln('To return to DOS press <RETURN> when asked for the file to read.');
  89.    writeln;
  90.    writeln('Defaults:   Input file extension - .PRG');
  91.    writeln('                Output Filename  -  same as input filename');
  92.    writeln('           Output file extension - .CLN');
  93.    writeln;
  94.    write('                    [ Press any key to return to DOS . . . ]');
  95.    wait;
  96.    ptwclose;
  97.    halt;
  98. end;
  99.  
  100. {check for disk/file errors, based upon IOError.pas in turbo tutor}
  101. PROCEDURE IOCheck(var IOerr : boolean);
  102. const
  103.   IOVal   : Integer = 0;
  104.   IOerror : boolean = False;
  105. var
  106.   Ch    : Char;
  107. begin
  108.   IOerr   := False;
  109.   IOVal   := IOresult;
  110.   IOError := (IOVal <> 0);
  111.   if IOError then begin
  112.     IOerr := True;
  113.     GotoXY (3,5);
  114.     case IOVal of
  115.       $01  :  Write('Error: Input file ',InFileName,' does not exist.');
  116.       $05  :  Write('Error: Can''t read from the input file.');
  117.       $06  :  Write('Error: Can''t write to output file.');
  118.       $F0  :  Write('Error: Disk write error.');
  119.       $F1  :  Write('Error: Directory is full.');
  120.     else      Write('Unknown I/O error:  ',IOVal:3)
  121.     end;
  122.     GotoXY (3,7); Write('Press any key to continue . . . ');
  123.     write(chr(7));
  124.     wait;
  125.   end
  126. end; { of proc IOCheck }
  127.  
  128. {***Open window for getting filenames***}
  129. Procedure OpenWindowOne;
  130. begin
  131.    PTWOpen (1);
  132.    ClrScr;
  133.    GotoXY (3,1); Write('CLEAN, Version 2.1 by Craig Steinberg. ');
  134.    Write(' [CLEAN ? = help]');
  135. end;
  136.  
  137. {**************}
  138. { MAIN PROGRAM }
  139. {**************}
  140.  
  141. Begin
  142.  
  143.    {***get/set current video mode***}
  144.    value := Mem[0000:$0449];
  145.    if value = 7 then PTOOLWIN_Screen_Type := 'M'
  146.    else PTOOLWIN_Screen_Type := 'C';
  147.  
  148.    {***Help screen requested?***}
  149.    if ParamStr(1) = '?' then help;
  150.  
  151.    {***Prepare the windows***}
  152.    WindowSetup;
  153.  
  154.    {***Check the Flags and set up variables accordingly***}
  155.    If (ParamCount = 1) then begin
  156.       ps := ParamStr(1);
  157.       f := copy(PS,1,1);
  158.       if f = '/' then begin
  159.          repeat {until length(PS) = 0}
  160.             delete(PS,1,1);
  161.             f := copy(PS,1,1);
  162.             if (f = 'C') or (f = 'c') then Comment := False;
  163.             if (f = 'I') or (f = 'i') then Indent  := False;
  164.             if (f = 'B') or (f = 'b') then Blank   := False;
  165.          until length(PS) = 0;
  166.          end
  167.       else help;
  168.    end;
  169.  
  170.    {***Open the filename window***}
  171.    OpenWindowOne;
  172.  
  173.    {****Loop to repeat until no filename is entered****}
  174.    Repeat  {until length(InFileName) = 0}
  175.  
  176.       {***clear bottom part of window***}
  177.       GotoXY(1,3); ClrEol;
  178.       GotoXY(1,4); ClrEol;
  179.       GotoXY(1,5); ClrEol;
  180.       GotoXY(1,7); ClrEol;
  181.       GotoXY(1,9); ClrEol;
  182.  
  183.       {***Get Input Filename***}
  184.       GotoXY ( 3,3);  Write('Enter file to read [.prg]: ');
  185.       GotoXY ( 3,4);  Write('Press RETURN to quit program.');
  186.       GotoXY (31,3);  Read(InFileName);
  187.       GotoXY ( 1,4);  ClrEol;
  188.  
  189.       {***If no ext is given and more than eight char are entered...***}
  190.       If (pos('.',InFileName) = 0) and (length(InFileName) > 8) then
  191.          InFileName := copy(InFileName,1,8);
  192.  
  193.       {***Add default ext if needed and Open input file***}
  194.       IF length(InFileName) > 0 then
  195.       Begin
  196.          if pos('.',InFileName) = 0 then InFileName := InFileName + '.prg';
  197.          {$I-}
  198.          Assign(InFile,InFileName);  IOCheck(IOerr);
  199.          Reset(InFile);  IOCheck(IOerr);
  200.          {$I+}
  201.  
  202.          {***Did an I/O error occur?***}
  203.          if not IOerr then
  204.          begin
  205.  
  206.          {***Get Output Filename***}
  207.          OutFileName := InFileName;                   {save filename}
  208.          delete(OutFileName,Pos('.',OutfileName),4);  {remove ext}
  209.          OutFileName := OutFileName + '.cln';         {save default ext}
  210.  
  211.          GotoXY ( 3,4); write('Enter file to write (',OutfileName,'):');
  212.          GotoXY (28+length(OutFileName),4);  read(OutFileNameT);
  213.  
  214.          {***Save output name to real var from temporary one***}
  215.          if length(OutFileNameT) > 0 then OutFileName := OutFileNameT;
  216.  
  217.          {***If no ext is given and more than eight char are entered...***}
  218.          If (pos('.',OutFileName) = 0) and (length(OutFileName) > 8) then
  219.             OutFileName := copy(OutFileName,1,8);
  220.  
  221.          {***Add default ext if one is needed***}
  222.          if Pos('.',OutFileName) = 0 then OutFileName := OutFileName + '.cln';
  223.  
  224.          {***Open output file and erase if exists***}
  225.          {$I-}
  226.          Assign(OutFile,OutFileName);  IOCheck(IOerr);
  227.          Rewrite(OutFile);  IOCheck(IOerr);
  228.          {$I+}
  229.  
  230.          {****Open Processing Window****}
  231.          PTWOpen (2);
  232.          ClrScr;
  233.          GotoXY (17,2);  Write('Processing Control Window');
  234.          GotoXY (17,3);  write('-------------------------');
  235.          GotoXY (17,4);  write(' Input file: ',InFileName);
  236.          GotoXY (17,5);  write('Output file: ',OutFileName);
  237.          GotoXY (17,7);  write('Processing line number: ');
  238.  
  239.          {****READY TO PROCESS NOW****}
  240.          l := 1;  {start with line number one}
  241.          Repeat {until eof}
  242.             Readln(InFile,line);
  243.             NextLine := False;
  244.             GotoXY (42,7);  write(l);  l := l + 1;
  245.             Repeat {until nextline = T}
  246.                begin
  247.                   c := copy(line,1,1);
  248.  
  249.                   {**if its a blank line go to the next line**}
  250.                   if ((length(line) = 0) and blank) then NextLine := True
  251.                   else
  252.  
  253.                      {**if its a comment line go to the next line**}
  254.                      If ((c = '*') and comment) then NextLine := True
  255.                      else
  256.  
  257.                         {**if its an indented line remove the first space**}
  258.                         {**then repeat the loop and check the next line  **}
  259.                         if ((c = chr(32)) and indent) then delete(line,1,1)
  260.  
  261.                         else begin
  262.                            {**if its none of the above, save the line**}
  263.                            {**and exit to go get the next line of data*}
  264.                            Writeln(OutFile,line);
  265.                            NextLine := True;
  266.                         end;
  267.                end;
  268.             until NextLine = True;
  269.          until EOF(InFile);
  270.  
  271.          {***close files***}
  272.          Close(InFile);
  273.          Close(OutFile);
  274.  
  275.          {***Now this file is finished so get next file to process***}
  276.          GotoXY (17,9); write('Done.  Press any key . . .');
  277.          write(chr(7));
  278.          wait;
  279.          PTWClose;
  280.          end;
  281.       end;
  282.    Until length(InFileName) = 0;
  283.  
  284.    {***All is done, clean up things***}
  285.    PTWClose ;
  286. End.
  287.